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-- Driver. mesa, last modified by Sweet, Aug 29, 1978 11:44 AM 

DIRECTORY 

AUoDefs: FROM "altodefs" USING [Address, BYTE, wordlength]. 

Code: FROM "code" USING [acstack, actenable, catchcount, catchoutrecord, CodePassInconsistancy , codep 
**tr, curbodyretlabel , curctxlvl, fileindex, f irstcaseselread, framesz, mainBody, StackNotEmptyAtStatem 
**ent, stking, tempcontext, tempstart. xtracting, xtractsei, ZEROlexeme], 

CodeDefs: FROM "codedefs" USING [AddressNotify , BDOIndex, BDONull, CallsNotify. CCIndex, CCItem, CCNu 
**n, ChunkBase, Chunklndex, CodeCCIndex, CodeChunkType, ExpressionNotify, FinalNotify, FlowExpressionN 
**otify, FlowNotify, FullBitAddress , JumpCCIndex, JumpCCNuH , JumpsNotify, JumpType, LabelCCIndex, Labe 
♦*lCCNun, Lexeme, MaxParmsInStack, NULLf ileindex. OutCodeNotify, PeepholeNotify , StackNotify, Statemen 
**tNotify, StoreNotify, topostack], 

ComData: FROM "comdata" USING [bodylndex, bodyRoot, mainBody. nErrors, objectBytes, objectFrameSize, 
♦♦stopping, textlndex, typeSTRING], 

ControlDefs: FROM "controldef s" USING [codebaseOff set, framelink, globalbase, localbase, MaxAllocSlot 
♦♦. returnOffset], 

ErrorDefs: FROM "errordefs" USING [errorsei], 

FOpCodes: FROM "fopcodes" USING [qALLOC. qDUP, qFREE. qJ. qJREL, qLADRB, qLI, qLINKB, qLL. qME, qMEL. 
♦♦ qMXD, qMXDL, qPUSH, qRET, qSG], 

InlineDefs: FROM "in! inedef s". 

LitDefs: FROM "litdefs" USING [FindLiteral , LiteralValue], 

OpTableDefs: FROM "optabledef s" USING [instlength], 

P5ADefs: FROM "p5adefs" USING [Addresslnit, adjustacstack, chkacstack, chkrandsonstack, clearstack. c 
♦♦opyBDOItem, CRassign, Csyserror, dumpstack, f reetempi ist, gentemplex, incrstack, insertlabel, loadtso 
♦♦naddress, LogHeapFree, makeTOSaddrBDOItem, NumberOf Params, P5Error, pop, purgependtempi ist, PushEffec 
♦♦t, putrandsonstack, releaseBDOItem, sCassign, slCassign, StackFinal, Stacklnit, stackoff, stackon, tr 
♦♦ansferconstruct], 

P5BDefs: FROM "pSbdefs" USING [Cfixup, Cstatement, endcodefile. outbinary, ProcessGlobalStrings, Proc 
♦♦essLocalStrings , pushlex, pushlitval, startcodef ile] , 

P5StmtExprDefs: FROM "p5stmtexprdef s" . 

SymDefs: FROM "symdefs" USING [BitAddress. bodytype, BTIndex, BTNull , Bytelndex, CBTIndex. ContextLev 
♦♦el. CSEIndex, CSENull , CTXIndex, ctxtype, HTIndex. HTNull , ISEIndex. ISENull , IG, IL, MDIndex. record 
♦♦CSEIndex. recordCSENull , SEIndex, SENull, setype, typeTYPE], 

SymTabDefs: FROM "symtabdefs" USING [FnField, NextSe, UnderType, WordsForType]. 

TableDefs: FROM "tabledefs" USING [FreeChunk. GetChunk, TableBase. TableNotif ier], 

TreeDefs: FROM "treedefs" USING [empty, freenode, scanlist, Treelndex, TreeLink, treetype]; 

DEFINITIONS FROM CodeDefs; 

Driver: PROGRAM 

IMPORTS MPtr: ComData, CPtr: Code, CodeDefs, ErrorDefs, LitDefs, OpTableDefs. P5ADefs, P5BDefs. Sym 
♦♦TabDefs, TableDefs, TreeDefs 

EXPORTS CodeDefs, P5ADefs, P5StmtExprDef s ■ 
BEGIN 
OPEN SymTabDefs, P5ADefs, P5BDefs; 

-- imported definitions 

Address: TYPE = AT toDefs .Address; 

BYTE: TYPE = Al toDef s .BYTE; 

wordlength: CARDINAL « AUoDefs. wordlength; 

codebaseOffset: CARDINAL = ControlDefs .codebaseOffset; 
framelink: CARDINAL « ControlDefs. framel ink; 
returnOffset: CARDINAL « ControlDefs . returnOffset; 
localbase: CARDINAL ■ ControlDefs. localbase; 
globalbase: CARDINAL = ControlDefs. globalbase; 

BitAddress: TYPE » SymDefs .BitAddress; 

BTIndex: TYPE « SymDefs .BTIndex; 

CBTIndex: TYPE = SymDefs .CBTIndex; 

BTNull: BTIndex « SymDef s. BTNull ; 

ContextLevel : TYPE « SymDef s.ContextLevel ; 

CSEIndex: TYPE = SymDef s .CSEIndex; 

CSENull: CSEIndex » SymDef s .CSENull ; 

CTXIndex: TYPE » SymDef s .CTXIndex; 

HTIndex: TYPE « SymDef s .HTIndex; 

HTNull: HTIndex » SymDef s. HTNull ; 

ISEIndex: TYPE « SymDef s . ISEIndex; 

ISENull: ISEIndex « SymDef s . ISENull ; 

IG: ContextLevel - SymDefs. IG; 

IL: ContextLevel - SymDefs. IL; 

MDIndex: TYPE « SymDef s .MDIndex; 

recordCSEIndex: TYPE - SymDef s . recordCSEIndex; 

recordCSENull: recordCSEIndex « SymDef s. recordCSENull ; 
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SEIndex: TYPE ■ SymDef s.SEIndex; 
SENull: SEIndex ■ SymDef s.SENull ; 
typeTYPE: CSEIndex » SymDef s. typeTYPE; 

empty: TreeLink ■ TreeDefs. empty; 
Treelndex: TYPE ■ TreeDefs. Treelndex; 
TreeLink: TYPE ■ TreeDefs. TreeLink; 

tb: TableDefs.TableBase; -- tree base (local copy) 

seb: TableDefs.TableBase; -- semantic entry base (local copy) 

ctxb: TableDefs.TableBase; -- context entry base (local copy) 

bb: TableDefs.TableBase; -- body entry base (local copy) 

cb: ChunkBase; -- code base (local copy) 

DriverNotify: PUBLIC TableDef s.TableNotif ier ■ 

BEGIN -- called by allocator whenever table area is repacked 

seb <- base[SymDef s.setype]; 

ctxb *- base[SymDefs.ctxtype]; 

bb ^ base[SymDefs.bodytype]; 

tb ^ base[TreeDefs.treetype]; 

cb <r LOOPHOLE[tb]; 

AddressNotify[base]; 

Express ionNotify[base]; 

FlowExpressionNotify[base3; 

FlowNotify[base]; 

StackNotify[base]; 

StatementNotify[base3; 

StoreNotify[base]; 

CallsNotify[base]; 

OutCodeNotify[base]; 

FinalNotify[base]; 

JumpsNotify[base]; 

PeepholeNotify[base]; 

RETURN 

END; 

codestart: CCIndex; 

endofcurbody: LabelCCIndex; 

bodyinrecord, bodyoutrecord: recordCSEIndex; 

codeindex: SymDef s .Bytelndex; 

mlock: TreeLink; 

longlock: BOOLEAN; 

Cmodule: PUBLIC PROCEDURE - 

BEGIN -- main driver for code generation 
bti, prev: BTIndex; 

CPtr.acstack <- 0; 

bodyinrecord <- bodyoutrecord ^ recordCSENull ; 

CPtr .ZEROlexeme ^ Lexeme[l i teral[word[LitDef s .FindLiteral[0]]]] ; 

Addresslnit[]; 

Stacklnit[]; 

stackoff[]; 

CPtr .xtracting ^ FALSE; 

CPtr .firstcaseselread ♦- FALSE; 

codeindex ♦- CPtr .f ileindex ♦- 0; 

CPtr .catchoutrecord ^ recordCSENull; 

CPtr .catchcount <- 0; 

CPtr .actenable <- LabelCCNull; 

CPtr .codeptr*- codestart ♦- CCNull; 

startcodef ile[]; 

bti ^ MPtr.bodyRoot; 

DO 

WITH (bb+bti) SELECT FROM 

Callable -> Cbody[LOOPHOLE[bti]]; 
ENDCASE; 
IF (bb+bti). firstSon # BTNull 
THEN bti ^ (bb+bti). firstSon 
ELSE 
DO 

prev <- bti; bti <- (bb+bti) . 1 ink. index; 
IF bti « BTNull THEN GO TO Done; 
IF (bb+prev). link. which ^ parent THEN EXIT; 
ENDLOOP; 
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REPEAT 

Done -> NULL; 

ENDLOOP; 
MPtr.objectBytes ♦- endcodef ne[]; 
StackFinal[]; 
RETURN; 
END; 

Cbody: PROCEDURE [bti: CBTIndex] - 
BEGIN -- produces code for body 
psei: CSEIndex *- UnderType[(bbtbti) . ioType]; 
bodynode: Treelndex; 
retryentry: LabelCCIndex; 
lockaddrsize: CARDINAL; 

CPtr.mainBody <- bti » MPtr.mainBody; 
MPtr.bodylndex <- bti; 

WITH bi: (bb+bti) . info SELECT FROM 
Internal -> 
BEGIN 

MPtr. textlndex <- bi .sourcelndex; 
bodynode <- bi.bodyTree; 
CPtr.curctxlvl <- (bb+bti) . level ; 

-- set up input and output contexts 
WITH (seb+psei) SELECT FROM 
transfer «> 
BEGIN 

bodyinrecord *■ LOOPHOLE[UnderType[inrecord] , recordCSEIndex]; 
IF bodyinrecord # recordCSENull THEN 

{ctxb+(seb+bodyinrecord) .f ieldctx) .ctxlevel ♦- CPtr.curctxlvl ; 
bodyoutrecord <- LOOPHOLE[UnderType[outrecord] , recordCSEIndex]; 
IF bodyoutrecord # recordCSENull THEN 

{ctxb+{seb+bodyoutrecord) .f ieldctx) . ctxlevel ♦- CPtr.curctxlvl; 
END; 
ENDCASE; 

IF CPtr.mainBody THEN 

BEGIN 

MPtr.objectFrameSize ^ bi .f rameSize; 

bi.frameSize <- localbase; 

CPtr.curctxlvl <- IL; 

END; 
CPtr. tempstart ♦- CPtr.framesz <- bi.frameSize; 
codeindex <- CPtr.f ileindex +- bi .sourcelndex; 

-- init the code stream and put down bracketing labels 

CPtr.curbodyretlabel ♦- labelalloc[] ; 
endofcurbody ♦- labelalloc[] ; 
CPtr.codeptr ♦- CCNull ; 
codestart ^ createlabel[]; 

— init data for creating temporaries 

(ctxb+CPtr.tempcontext).ctxlevel <- CPtr.curctxlvl; 

-- tuck parameters away into the frame 

IF CPtr.acstack ff THEN SIGNAL CPtr .StackNotEmptyAtStatement; 
WITH (bb+bti) SELECT FROM 
Inner «> BEGIN 

CPtr.acstack <- 1; 

Cioutl[FOpCodes.qLINKB, frameOff set- local base]; 

END; 
ENDCASE; 
stackon[]; 

popinvals[bodyinrecord, FALSE]; 
purgependtempl ist[]; 

-- do string literals 

IF CPtr.mainBody THEN 
MPtr.objectFrameSize +- ProcessGlobal Strings [MPtr.objectFrameSize]; 
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CPtr.tempstart ♦- ProcessLoca1Strings[CPtr. tempstart, bi .stOrigin]; 
bi.frameSize ♦- CPtr.framesz <- MAX [CPtr .framesz, CPtr.tempstart]; 

-- do initialization code and main body 

IF CPtr.mainBody AND MPtr. stopping THEN 
BEGIN OPEN FOpCodes; 
Cioutl[qLADRB. 0]; 
Cioutl[qSG, globalbase]; 
END; 

IF (tb+bodynode).attrl THEN 

BEGIN 

insert1abe1[retryentry ♦- 1abelanoc[]]; 

lockaddrsize ♦- loadtsonaddress[(m1ock ♦• (tb+bodynode).son4)]; 

longlock ^ lockaddrsize > wordlength; 

CioutO[IF longlock THEN FOpCodes. qMEL 
ELSE FOpCodes. qME]; 

Cioutl[FOpCodes.qLI, 0]; 

Coutjump[JumpE, retryentry]; 

END 
ELSE mlock ^ empty; 

(tb+bodynode) .son2 ♦- Cstatement[( tb+bodynode) .son2]; 

(tb+bodynode) .son3 ^ Cstatement[(tb+bodynode) .son3]; 

(tb+bodynode) .sonl <- TreeDefs. empty; 

insert! ab el [endofcurbody]; 

IF CPtr.acstack # THEN SIGNAL CPtr .StackNotEmptyAtStatement; 

-- push the return values onto the stack 

IF mlock # empty THEN 

BEGIN [] ^ loadtsonaddress[mlock]; 

CioutO[IF longlock THEN FOpCodes. qMXDL ELSE FOpCodes .qMXD]; 

END; 
pushretvals[]; 
clearstack[]; 
CPtr.acstack ^ 0; 

insertl abel [CPtr. curbody ret label]; 
IF CPtr.mainBody AND MPtr. stopping THEN 

BEGIN Cioutl[FOpCodes.qLI, 0]; Cioutl[FOpCodes .qSG, globalbase]; END; 
stackoff[]; 

C ioutO[ FOpCodes. qRET]; 
purgepend tempi ist[]; 

-- write frame size into bodyitem 

bi.frameSize ^ CPtr.framesz; 
WITH (bb+bti) SELECT FROM 

Inner => IF bi.frameSize > f ramevec[LENGTH[f ramevec]-!] 
THEN ErrorDef s.errorsei[addressOverf low, id]; 

ENDCASE; 

-- fixup jumps 

IF MPtr.nErrors - THEN Cf ixup[codestart]; 

-- output the object code 

codeindex <- CPtr .f ileindex ^ NULLf ileindex; 

TreeDefs .freenode [body node] ; 

IF MPtr.nErrors ■ THEN outbinary[bti , codestart] 

ELSE 

BEGIN 

c, next; CCIndex; 

FOR c ^ codestart. next WHILE c # CCNull DO 
next ^ cb[c].flink; 
deletecel l[c]; 
ENDLOOP; 

END; 
freetempl ist[]; 
END; 

ENDCASE; 
RETURN 
END; 



Driver. mesa 2-Sep-78 12:59:59 Page 



popparams: PROCEDURE [sei: ISEIndex] ■ 

BEGIN -- recursive routine to store params from acstack into 

-- frame in lifo order 
IF sei - ISENun THEN RETURN; 
popparams[nextvar[NextSe[sei]]]; 
sCassign[sei]; 
RETURN 
END; 

popinvals: PUBLIC PROCEDURE [irecord: recordCSEIndex, isenable: BOOLEAN] ■ 
BEGIN -- sets up input parameters if number of parms exceeds acstack 
1 : bdo Lexeme; 
nparms: CARDINAL; 
r: BDOIndex; 
b: BitAddress; 
sei: ISEIndex; 

tlex: se Lexeme ♦- topostack; 
dup: BOOLEAN; 
nwds: CARDINAL; 

IF irecord - CSENull THEN RETURN; 
nparms *- wordsforsei[irecord]; 
IF isenable THEN 

IF nparms <» 1 THEN RETURN 
ELSE Cioutl[F0pCodes.qLL,loca1base+l]; 
sei <- nextvar[(ctxb+(seb+irecord) .f ieldctx) .sei ist]; 
IF nparms > MaxParmsInStack OR (isenable AND nparms > 1) THEN 
BEGIN 
IF disenable THEN 

BEGIN CPtr. acstack ^ 1; incrstack[l] END; 
1 ♦- Lexeme[bdo[]]; 
UNTIL sei » ISENull DO 

r <- l.lexbdoi ♦- makeTOSaddrBDOItem[wordlength]; 

[b, cb[r]. offset. size] ♦- FnField[sei]; 

cb[r]. offset. posn ♦- FunBitAddress[wd: b.wd. bd: b.bd]; 

nwds ♦- cb[r].off set.size/wordlength; 

dup ^ -isenable OR nextvar[NextSe[sei]] # ISENull; 

IF dup THEN 

IF nwds <« 2 THEN CioutO[FOpCodes.qDUP] 
ELSE IF tlex = topostack THEN 
BEGIN 

tlex ♦- gentemplex[l]; 
sCassign[tlex.lexsei]; 
CioutO[FOpCodes.qPUSH]; 
END; 
slCassign[sei , 1. FALSE, nwds]; 
sei <- nextvar[NextSe[sei]]; 
IF dup AND nwds > 2 THEN pushlex[tlex]; 
ENDLOOP; 
IF -isenable THEN CioutO[FOpCodes.qFREE]; 
END 
ELSE 

BEGIN CPtr. acstack ^ nparms; incrstack[nparms]; popparams[sei]; END; 
CPtr. acstack <- 0; 
RETURN 
END; 

pushretvals: PROCEDURE » 

BEGIN -- pushes the return vals from a body onto the stack 

sei: ISEIndex; 

1 : se Lexeme; 

r, rr: BDOIndex; 

b: BitAddress; 

nretvals: CARDINAL; 

IF bodyoutrecord « CSENull THEN RETURN; 

nretvals <- wordsforsei[bodyoutrecord]; 

sei ♦- (ctxb+(seb+bodyoutrecord) .f ieldctx) .sei ist; 

IF (seb+nextvar[sei]).htptr « HTNull THEN -- anonymous RETURNS list 

BEGIN 

Csyserror[]; 



Driver. mesa 2-Sep-78 12:59:59 Page 6 



RETURN 
END; 
IF nretvals > MaxParmsInStack THEN 
BEGIN 

push litval[computeframesize[ nretvals]]; 
CioutO[FOpCodes.qALLOC]; 
r ♦- makeTOSaddrBDOItem[worcnength]; 
UNTIL (sei <- nextvar[sei]) - ISENull DO 
rr <- copyBDOItem[r]; 

[b, cb[rr]. offset. size] ♦■ FnField[sei]; 
cb[rr]. offset. posn *• FunBitAddress[wd: b.wd. bd: b.bd]; 
CRassign[rr, empty, sei, TRUE]; 
sei ^ NextSe[sei]; 
ENDLOOP; 
chkrandsonstack[l]; 
releaseBDOItem[r]; 
RETURN 
END; 
1 <- Lexeme[se[]]; 
UNTIL (sei ^ nextvar[sei]) - ISENull DO 

l.lexsei <- sei; pushlex[l]; sei ^ NextSe[sei]; ENDLOOP; 
RETURN 
END; 

wordsforsei: PUBLIC PROCEDURE [sei: SEIndex] RETURNS [CARDINAL] - 
BEGIN 

RETURN [IF sei » SENull THEN ELSE WordsForType[UnderType[sei]]]; 
END; 

wordsforoperand: PUBLIC PROCEDURE [t: TreeLink] RETURNS [n: CARDINAL] 
BEGIN -- compute number of words for storing value of tree 
WITH t SELECT FROM 

literal => n <- 1; 

symbol => n <- wordsf orsei[(seb+index) . idtype] ; 

subtree «> n ♦- WordsForType[operandtype[t]] ; 

ENDCASE; 
RETURN 
END; 

bitsfortype: PUBLIC PROCEDURE [sei: SEIndex] RETURNS [CARDINAL] - 
BEGIN 
csei: CSEIndex <- UnderType[sei]; 

WITH (seb+csei) SELECT FROM 

record => RETURN[length]; 

ENDCASE «> RETURN[WordsForType[sei]*wordlength] 
END; 



bitsforoperand: PUBLIC PROCEDURE [t: TreeLink] RETURNS [CARDINAL] 
BEGIN 

RETURN[bitsfortype[operandtype[t]]] 
END; 



operandtype: PUBLIC PROCEDURE [t: TreeLink] RETURNS [sei: CSEIndex] 
BEGIN -- compute number of words for storing value of tree 
WITH e:t SELECT FROM 
literal »> 

WITH e.info SELECT FROM 

string => sei *■ MPtr . typeSTRING; 
ENDCASE «> SIGNAL CPtr .CodePassInconsistancy ; 
symbol «> sei ♦- UnderType[(seb+e. index) . idtype]; 
subtree ■> 

IF e - empty THEN 

IF CPtr.xtracting THEN 

sei <r UnderType[(seb+CPtr.xtractsei) . idtype] 
ELSE ERROR 
ELSE sei ^ (tb+e. index) . info; 
ENDCASE; 
RETURN 
END; 
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ReleaseLock: PUBLIC PROCEDURE - 
BEGIN 

RequireStack[0]; 
[] <- 1oadtsonaddress[m1ock]; 

CioutO[IF longlock THEN FOpCodes .qMXDL ELSE FOpCodes.qMXD] ; 
RETURN 
END; 

sCreturn: PROCEDURE [node: Treelndex, isresume: BOOLEAN] ■ 
BEGIN -- generate code for RETURN and RESUME 
savacstack: CARDINAL <r CPtr .acstack; 
nretvals: CARDINAL; 
rsei: CSEIndex; 
monitored: BOOLEAN; 

monitored ^ -isresume AND (tb+node) . attrl; 
IF isresume OR -commonretCC tb+node) . sonl] THEN 
BEGIN 
IF monitored AND (tb+node) .attr2 THEN 

BEGIN ReleaseLock[]; monitored ^ FALSE; END; 
rsei <- IF isresume THEN CPtr.catchoutrecord ELSE bodyoutrecord; 
nretvals <- IF rsei - CSENull THEN ELSE WordsForType[UnderType[rsei]]; 
IF nretvals > MaxParmsInStack OR (isresume AND nretvals > 1) THEN 

BEGIN 

pushlitval[computeframesize[nretvals]]; 

CioutO[ FOpCodes. qALLOC]; 

t ran sf ercon St rue t[makeTOSaddrBDOItem[word length], (tb+node) .sonl, rsei]; 

nretvals ♦- 1; 

END 
ELSE transferconstruct[BDONull . (tb+node) . sonl, rsei]; 
IF monitored THEN ReleaseLock[]; 
chkrandsonstack[nretvals]; 
IF isresume THEN 

BEGIN pushlitval[l]; adjustacstack[-l]; pop[]; CioutO[FOpCodes.qRET]; 

Coutjump[JumpRet. Label CCNull]; 

END 
ELSE Coutjump[Jump. CPtr.curbodyretlabel]; 
CPtr. acstack <- savacstack; 
END 
ELSE Coutjump[Jump, endofcurbody]; 
RETURN 
END; 

Creturn: PUBLIC PROCEDURE [node: Treelndex] - 
BEGIN -- produce code for RETURN 

sCreturn[node, FALSE ILogHeapFree -> RESUME[FALSE, topostack]]; RETURN 
END; 

Cresume: PUBLIC PROCEDURE [node: Treelndex] ■ 
BEGIN -- produce code for RESUME 

sCreturn[node. TRUE ILogHeapFree »> RESUME[FALSE, topostack]]; RETURN 
END; 

commonret: PROCEDURE [t: TreeLink] RETURNS [common: BOOLEAN] - 

BEGIN -- test if the returns list duplicats the returns declaration 
sei : ISEIndex; 

scr: PROCEDURE [t: TreeLink] - 
BEGIN 

IF -common THEN RETURN; 
WITH t SELECT FROM 

literal «> common <- FALSE; 
symbol ■> common *- sei ■ index; 
subtree «> common ^ FALSE; 
ENDCASE; 
IF sei ff SENull THEN sei ^ nextvar[NextSe[sei]]; 
RETURN 
END; 

common ♦- TRUE; 

IF t - empty THEN RETURN; 

IF bodyoutrecord ^ CSENull THEN 
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sei ^ nextvar[(ctxb+(seb+bodyoutrecord) .f ie1clctx).sel1st3 
ELSE RETURN [FALSE]; 
TreeDefs.scanlist[t, scr]; 
RETURN 
END; 

nextvar: PUBLIC PROCEDURE [sei: ISEIndex] RETURNS [ISEIndex] - 
BEGIN -- starting at sei returns first variable on ctx-list 
IF sei " ISENun THEN RETURN [ISENull]; 
DO 

IF (seb+sei).idtype # typeTYPE THEN RETURN [sei]; 

IF (sei <r NextSe[sei]) - ISENull THEN EXIT; 

ENDLOOP; 
RETURN [ISENull]; 
END; 

prewar: PUBLIC PROCEDURE [ssei, sei : ISEIndex] RETURNS [ISEIndex] - 
BEGIN -- returns vars in reverse order as those returned by nextvar 
psei: ISEIndex <- nextvar[ssei]; 
rsei: ISEIndex; 

IF psei - sei THEN RETURN [psei]; 
UNTIL psei » sei DO 

rsei ♦- psei; psei <- nextvar[NextSe[psei]]; ENDLOOP; 
RETURN [rsei]; 
END; 

CioutO: PUBLIC PROCEDURE [i: BYTE] - 

BEGIN -- outputs an parameter-less instruction 

c: CodeCCIndex; 

pusheffect: INTEGER « PushEf fect[i]; 

chkacstack[i]; 

IF NumberOfParams[i] # THEN P5ADef s. P5Error[257]; 

codeindex <- MAX[CPtr .f ileindex, codeindex]; 

c <- AnocCodeCCItem[0]; 

cb[c].inst <- i; 

cb[c].minimalStack <- CPtr.acstack - pusheffect; 

RETURN 

END; 

Cioutl: PUBLIC PROCEDURE [i: BYTE, pi: WORD] - 
BEGIN -- outputs an one-parameter instruction 
c: CodeCCIndex; 
pusheffect: INTEGER - PushEf fect[i]; 

chkacstack[i]; 

IF NumberOfParams[i] # 1 THEN PSADef s.P5Error[258]; 

codeindex *- MAX[CPtr,f ileindex, codeindex]; 

c <- AllocCodeCCItem[l]; 

cb[c]. inst ♦• i; 

cb[c] .parameters[l] ♦- pi; 

cb[c] .minimalStack ^ CPtr.acstack » pusheffect; 

RETURN 

END; 

Ciout2: PUBLIC PROCEDURE [i: BYTE, pi. p2: WORD] - 
BEGIN -- outputs an two-parameter instruction 
c: CodeCCIndex; 
pusheffect: INTEGER « PushEf fect[i]; 

chkacstack[i]; 

IF NumberOfParams[i] ^ 2 THEN P5ADef s. P5Error[269]; 

codeindex <- MAX[CPtr.f ileindex. codeindex]; 

c ^ AllocCodeCCItem[2]; 

cb[c]. inst ♦- i; 

cb[c].parameters[l] <- pi; 

cb[c3.parameters[2] <- p2; 

cb[c] .minimalStack <- CPtr.acstack ■ pusheffect; 

RETURN 

END; 
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Ciout3: PUBLIC PROCEDURE [i: BYTE. pi. p2, p3; WORD] - 
BEGIN -- outputs an three-parameter instruction 
c: CodeCCIndex; 
pusheffect: INTEGER - PushEffect[i]; 

chkacstack[i]; 

IF NumberOfParams[i] # 3 THEN P5ADef s.P5Error[a60]; 

codeindex ♦- MAX[CPtr.f ileindex, codeindex]; 

c ♦- AnocCodeCCItem[3]; 

cb[c].inst ^ i ; 

cb[c].parameters[l] ^ pi; 

cb[c].parameters[2] ^ p2; 

cb[c].parameters[3] <- p3; 

cb[c].minima1Stack ^ CPtr.acstack ■ pusheffect; 

RETURN 

END; 

treeliteral; PUBLIC PROCEDURE [t: TreeLink] RETURNS [BOOLEAN] - 
BEGIN 

node: Treelndex; 
DO 
WITH t SELECT FROM 

literal »> RETURN[info.1 itTag » word]; 
subtree »> 

BEGIN node ♦■ index; 
SELECT (tb+node).name FROM 

cast, mwconst »> t <- (tb+node) .sonl; 
ENDCASE -> RETURN [FALSE]; 
END; 
ENDCASE -> RETURN[FALSE] 
ENDLOOP 
END; 

treeliteral value: PUBLIC PROCEDURE [t: TreeLink] RETURNS [WORD] - 
BEGIN 

node: Treelndex; 
DO 

WITH e:t SELECT FROM 
literal -> 

WITH e.info SELECT FROM 

word => RETURN [Li tDef s .LiteralValue[index]]; 
ENDCASE -> EXIT; 
subtree >»> 

BEGIN node <- e. index; 
SELECT (tb+node). name FROM 

cast, mwconst «> t ♦- (tb+node) .sonl ; 
ENDCASE ■> EXIT; 
END; 
ENDCASE «> EXIT 
ENDLOOP; 
P5ADefs.P5Error[261]; 
END; 

maketreeliteral: PUBLIC PROCEDURE [val : WORD] RETURNS [TreeLink] - 
BEGIN 

RETURN [TreeLink[literal[[word[ index: Li tDef s .FindLiteral [val ]]]]]] 
END; 

labelalloc: PUBLIC PROCEDURE RETURNS [c: LabelCCIndex] « 

BEGIN -- gets a chunk for a label but does not insert it in stream 
c ^ GetChunk[SIZE[label CCItem]]; 
cb[c] <- 

CCItem[free: FALSE, pad:0, flink: . blink: , ccvalue: label[labelseen: FALSE, jumplist: JumpCCN 
♦*ull]]; 
RETURN 
END; 

createlabel: PUBLIC PROCEDURE RETURNS [c: LabelCCIndex] - 
BEGIN -- allocates and inserts a label at codeptr 
c <- labelalloc[]; 
insertlabel[c]; 
RETURN 
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END; 

ccellanoc: PUBLIC PROCEDURE [t: CodeChunkType] - 
BEGIN -- allocates a cell for code or Jump 
c: CCIndex; 
nwords: CARDINAL; 

codeindex *- MAX[CPtr.f ileindex, codeindex]; 
SELECT t FROM 

code -> P5ADefs.P5Error[262]; 
label -> P5ADefs.P6ErrorC263]; 
jump »> nwords <- SIZE[jump CCItem]; 
other «> nwords ♦■ SIZE[other CCItem]; 
ENDCASE; 
c <- GetChunk[nwords]; 
SELECT t FROM 
jump ■> 
cbCc] *- 
CCItem[free: FALSE, pad:0, flink: , blink: , ccvalue: jump[. ,,.,.. .]]; 
other ■> 
cb[c] ^ 

CCItem[free: FALSE. pad:0. flink: , blink: , ccvalue: other[]]; 
ENDCASE; 
linkCCItem[c]; 
RETURN 
END; 

ParamCount: PUBLIC PROCEDURE [c: CodeCCIndex] RETURNS [CARDINAL] - 
BEGIN 
RETURNCIF cbCc].isize ^ THEN cb[c] . isize-l 

ELSE IF cb[c].realinst THEN OpTableDef s. instlength[cb[c]. inst]-l 
ELSE NumberOfParams[cb[c].inst]] 
END; 

AllocCodeCCItem: PUBLIC PROCEDURE [n: [0..3]] RETURNS [c: CodeCCIndex] - 

BEGIN 

c <r GetChunk[SIZE[code CCItem] + n]; 

cb[c] ♦- 

CCItem[free: FALSE, pad:0, flink: CCNull, blink: CCNull, ccvalue:, 
code[inst: 0, realinst: FALSE, minimalStack: FALSE, 
sourcef ileindex: NULLf ileindex, 
isize: 0, aligned: FALSE, fill: 0, parameters: ]]; 

IF CPtr.stking THEN cb[c]. sourcef ileindex <- codeindex; 

linkCCItem[c]; 

RETURN 

END; 

linkCCItem: PROCEDURE[c: CCIndex] - 

BEGIN -- inserts a CCItem in list codeptr 
IF CPtr. codeptr ^ CCNull THEN 

BEGIN 

cb[c]. flink <- cb[CPtr. codeptr] ,fl ink; 

IF cb[CPtr. codeptr]. flink # CCNull THEN 
cb[cb[CPtr. codeptr]. flink]. blink ♦- c; 

cb[CPtr.codeptr].f 1 ink <- c; 

END 
ELSE cb[c]. flink ♦- CCNull; 
cb[c]. blink <- CPtr .codeptr ; 
CPtr. codeptr ^ c; 
RETURN 
END; 

RequireStack: PUBLIC PROCEDURE [n: INTEGER] « 
BEGIN 
IF CPtr.acstack n THEN 

BEGIN 

dumpstack[]; 

IF n # THEN putrandsonstack[n]; 

END; 
RETURN 
END; 

Coutjump: PUBLIC PROCEDURE [jt: JumpType, 1: LabelCCIndex] - 
BEGIN -- outputs a jump-type code ceel into the code stream 
SELECT jt FROM 
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Jump, JumpA, JumpC. JumpCA, JumpRet ■> chkacstack[FOpCocles.qJ]; 
ENDCASE ■> chkacstack[FOpCodes.qJREL]; 
ccellanocCjump]; 
WITH cb[CPtr.codeptr] SELECT FROM 
jump ■> 
BEGIN 

fixedup <- FALSE; 
completed ^ FALSE; 
Jtype ♦- Jt; 
destlabel ^ 1 ; 
IF 1 # LabelCCNun THEN 
BEGIN 

thread ^ cb[1]. jumplist; 

cb[1]. jumplist ^ LOOPHOLE[CPtr.codeptr, JumpCCIndex]; 
END 
ELSE thread <- JumpCCNull ; 
RETURN 
END; 
ENDCASE 
END; 

deletecell: PUBLIC PROCEDURE [c: CCIndex] - 
BEGIN -- deletes cell from code stream 
nwords: CARDINAL; 

IF cb[c]. blink # CCNull THEN 

cb[cb[c3. blink]. flink <- cb[c].flink; 
IF cbCc].flink # CCNull THEN 

cb[cb[c].flink]. blink *- cb[c]. blink; 
WITH Cb[c3 SELECT FROM 

code «> nwords ♦- ParamCount[L00PH0LE[c3] + SIZE[code CCItem]; 

label »> nwords ^ SIZE[label CCItem]; 

jump ■> nwords ♦- SIZE[jump CCItem]; 

other -> nwords <- SIZE[other CCItem]; 

ENDCASE; 
FreeChunk[c, nwords]; 
RETURN 
END; 

FreeChunk: PUBLIC PROCEDURE [i: CodeDef s .Chunklndex, size: CARDINAL] - 
BEGIN 

TableDefs.FreeChunk[L00PH0LE[i],si2e]; 
END; 

GetChunk: PUBLIC PROCEDURE [size: CARDINAL] RETURNS [CodeDef s .Chunklndex] 
BEGIN 

RETURN [LOOPHOLE[TableDefs.GetChunk[size]]]; 
END; 

framevec: ARRAY [0 . .ControlDef s.MaxAl locSlot) OF CARDINAL - [ 
7,11,15,19,23.27.31.39.47,56,67,79,95,111.127,147.171,199,231]; 

computeframesize: PUBLIC PROCEDURE [fs: CARDINAL] RETURNS [CARDINAL] ■ 
BEGIN -- finds alloc-vector index for frame of size fs 
fx: CARDINAL; 

FOR fx IN [CControlDefs-MaxAllocSlot) DO 

IF fs <« framevec[fx] THEN RETURN [fx] ENDLOOP; 
RETURN [fs]; 
END; 



END... 



